home *** CD-ROM | disk | FTP | other *** search
/ Win 50 Game+ Vol. 7 (Japan) / Win 50 Game+ Vol. 7 (Japan).7z / Win 50 Game+ Vol. 7 (Japan).bin / lha_file / dpgolf11.lzh / DPG11SRC.LZH / GLMAIN.PAS < prev   
Pascal/Delphi Source File  |  1996-08-21  |  13KB  |  481 lines
  1. unit Glmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, about, Menus, StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     Exit1: TMenuItem;
  13.     N1: TMenuItem;
  14.     Restart1: TMenuItem;
  15.     Help1: TMenuItem;
  16.     About1: TMenuItem;
  17.     Index1: TMenuItem;
  18.     Panel1: TPanel;
  19.     Shape1: TShape;
  20.     Image2: TImage;
  21.     Image3: TImage;
  22.     hata: TImage;
  23.     Timer1: TTimer;
  24.     New1: TMenuItem;
  25.     Shape2: TShape;
  26.     Label1: TLabel;
  27.     Label2: TLabel;
  28.     Label3: TLabel;
  29.     Label4: TLabel;
  30.     Bar1: TScrollBar;
  31.     Bar2: TScrollBar;
  32.     Label5: TLabel;
  33.     Label6: TLabel;
  34.     Button1: TButton;
  35.     showxy: TLabel;
  36.     Save1: TMenuItem;
  37.     Load1: TMenuItem;
  38.     Game1: TMenuItem;
  39.     Loadbox: TOpenDialog;
  40.     Savebox: TSaveDialog;
  41.     N2: TMenuItem;
  42.     Radio1: TRadioGroup;
  43.     Check1: TCheckBox;
  44.     procedure About1Click(Sender: TObject);
  45.     procedure FormCreate(Sender: TObject);
  46.     procedure FormPaint(Sender: TObject);
  47.     procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  48.       Shift: TShiftState; X, Y: Integer);
  49.     procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  50.       Shift: TShiftState; MX, MY: Integer);
  51.     procedure Timer1Timer(Sender: TObject);
  52.     procedure New1Click(Sender: TObject);
  53.     procedure Restart1Click(Sender: TObject);
  54.     procedure Bar1Change(Sender: TObject);
  55.     procedure Bar2Change(Sender: TObject);
  56.     procedure ResetbtnClick(Sender: TObject);
  57.     procedure Exit1Click(Sender: TObject);
  58.     procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
  59.       Y: Integer);
  60.     procedure Shape2MouseMove(Sender: TObject; Shift: TShiftState; X,
  61.       Y: Integer);
  62.     procedure Help1Click(Sender: TObject);
  63.     procedure Save1Click(Sender: TObject);
  64.     procedure Load1Click(Sender: TObject);
  65.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  66.       Shift: TShiftState; MX, MY: Integer);
  67.     procedure Check1Click(Sender: TObject);
  68.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  69.       Shift: TShiftState);
  70.   private
  71.     { Private ÉΘî╛ }
  72.     procedure showhole;
  73.     procedure pmstr(n : integer);
  74.   public
  75.     { Public ÉΘî╛ }
  76.   end;
  77.  
  78. var
  79.   Form1: TForm1;
  80.  
  81. implementation
  82.  
  83. {$R *.DFM}
  84. type str12 = string[12];
  85.  
  86. var    map : array[1..18,0..17,0..17] of byte;
  87.     dx, dy : array[1..18,1..16,1..16] of shortint;
  88.     hx, hy, bx, by : array[1..18] of byte;
  89.     hole, shot, score : integer;
  90.     data : file of byte;
  91.     rect1, rect2 : Trect;
  92.     nopress, cupin, nomove : boolean;
  93.     x, y, bdx, bdy, fr, ac : real;
  94.     path, fname : string;
  95.  
  96. procedure readcourse;
  97. var i, j, k : byte;
  98. begin
  99.     screen.cursor := crHourglass;
  100.        for i := 1 to 18 do for j := 0 to 17 do for k := 0 to 17 do map[i,k,j] := $88;
  101.     assignfile(data,fname);
  102.     reset(data);
  103.     if filesize(data) < 4644 then begin
  104.         randseed := filesize(data);
  105.         for i := 1 to 18 do begin
  106.             for j := 1 to 16 do for k := 1 to 16 do begin
  107.                 map[i,k,j] := random(256);
  108.                 dx[i,k,j] := map[i,k,j] mod 16 - 8;
  109.                 dy[i,k,j] := map[i,k,j] div 16 - 8;
  110.             end;
  111.             hx[i] := random(16) + 1;
  112.             hy[i] := random(16) + 1;
  113.             repeat
  114.                 bx[i] := random(16) + 1;
  115.                 by[i] := random(16) + 1;
  116.             until (hx[i] <> bx[i]) or (hy[i] <> by[i]);
  117.         end;
  118.     end else for i := 1 to 18 do begin
  119.         for j := 1 to 16 do for k := 1 to 16 do begin
  120.             read(data,map[i,k,j]);
  121.             dx[i,k,j] := map[i,k,j] mod 16 - 8;
  122.             dy[i,k,j] := map[i,k,j] div 16 - 8;
  123.         end;
  124.         read(data,j,k);
  125.         hx[i] := j mod 16 + 1;
  126.         hy[i] := j div 16 + 1;
  127.         k := 255 - k;
  128.         bx[i] := k mod 16 + 1;
  129.         by[i] := k div 16 + 1;
  130.     end;
  131.     closefile(data);
  132.     for i := 1 to 18 do for j := 0 to 17 do for k := 0 to 17 do
  133.         if map[i,k,j] = $88 then map[i,k,j] := 0 else map[i,k,j] := 1;
  134.     screen.cursor := crDefault;
  135. end;
  136.  
  137. procedure Tform1.pmstr(n : integer);
  138. begin
  139.     if n < 0 then label3.caption :=
  140.         'Score ' + inttostr(score) + ' (' + inttostr(n) + ')'
  141.              else label3.caption :=
  142.         'Score ' + inttostr(score) + ' (+' + inttostr(n) + ')';
  143. end;
  144.  
  145. procedure Tform1.showhole;
  146. var i, j : byte;
  147. begin
  148.     x := bx[hole] + 0.5;
  149.     y := by[hole] + 0.5;
  150.     cupin := false;
  151.     formpaint(exit1);
  152.     hata.left := (hx[hole] - 1) * 26 + 8;
  153.     hata.top := (hy[hole] - 1) * 26 - 15;
  154.     hata.refresh;
  155.     shot := 1;
  156.     label1.caption := 'Hole ' + inttostr(hole) + ' (par 2)';
  157.     label2.caption := 'Shot 1';
  158.     pmstr(score - (hole - 1) * 2);
  159.     label4.show;
  160. end;
  161.  
  162. procedure TForm1.Restart1Click(Sender: TObject);
  163. begin
  164.     score := 0;
  165.     hole := 1;
  166.     showhole;
  167. end;
  168.  
  169. procedure TForm1.New1Click(Sender: TObject);
  170. begin
  171.     with aboutbox do begin
  172.         clientheight := 165;
  173.         okbutton.hide;
  174.         makebtn.show;
  175.         cancelbtn.show;
  176.         combo1.show;
  177.         activecontrol := makebtn;
  178.         comment.caption := 'Please set parameters.';
  179.         showmodal;
  180.         if modalresult = mrOk then begin
  181.             fname := path + 'dpgolf.dat';
  182.             readcourse;
  183.             restart1click(sender);
  184.         end;
  185.         combo1.hide;
  186.         cancelbtn.hide;
  187.         makebtn.hide;
  188.         okbutton.show;
  189.         activecontrol := okbutton;
  190.         clientheight := 118;
  191.     end;
  192. end;
  193.  
  194. procedure TForm1.Save1Click(Sender: TObject);
  195. var j, k, l : integer;
  196.     a, b : byte;
  197. begin
  198.     savebox.filename := formatdatetime('mmddhhnn',now) + '.dpg';
  199.     if Savebox.execute then begin
  200.         screen.cursor := crHourGlass;
  201.         assignfile(data,savebox.filename);
  202.         rewrite(data);
  203.         for j := 1 to 18 do begin
  204.             for k := 1 to 16 do for l := 1 to 16 do begin
  205.                 a := (dy[j,l,k] + 8) * 16 + (dx[j,l,k] + 8);
  206.                 write(data,a);
  207.             end;
  208.             a := (hy[j] - 1) * 16 + (hx[j] - 1);
  209.             b := 255 - ((by[j] - 1) * 16 + (bx[j] - 1));
  210.             write(data,a,b);
  211.         end;
  212.         closefile(data);
  213.         screen.cursor := crDefault;
  214.     end;
  215. end;
  216.  
  217. procedure TForm1.Load1Click(Sender: TObject);
  218. begin
  219.     if loadbox.execute then begin
  220.         fname := loadbox.filename;
  221.         readcourse;
  222.         restart1click(sender);
  223.     end;
  224. end;
  225.  
  226. procedure TForm1.Exit1Click(Sender: TObject);
  227. begin
  228.     Application.terminate;
  229. end;
  230.  
  231. procedure TForm1.Help1Click(Sender: TObject);
  232. begin
  233.     application.helpjump('HID_N0001');
  234. end;
  235.  
  236. procedure TForm1.About1Click(Sender: TObject);
  237. begin
  238.     aboutbox.comment.caption := 'Welcome to Danchan Golf Club!';
  239.     aboutbox.showmodal;
  240. end;
  241.  
  242. procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
  243.   Y: Integer);
  244. var r, s : real;
  245. begin
  246.     r := (60-x) * sqrt(abs(60-x)) * 0.1;
  247.     s := (60-y) * sqrt(abs(60-y)) * 0.1;
  248.     showxy.caption := 'Power : ' + inttostr(round(sqrt(r*r+s*s))-2);
  249. end;
  250.  
  251. procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  252.   Shift: TShiftState; X, Y: Integer);
  253. begin
  254.     nopress := true;
  255. end;
  256.  
  257. procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  258.   Shift: TShiftState; MX, MY: Integer);
  259. begin
  260.     if nopress and nomove then begin
  261.         nopress := false;
  262.         label4.hide;
  263.         nomove := false;
  264.         bdx := (60-mx) * sqrt(abs(60-mx)) * 0.00295;
  265.         bdy := (60-my) * sqrt(abs(60-my)) * 0.00295;
  266.         game1.enabled := false;
  267.         timer1.enabled := true;
  268.         repeat application.processmessages
  269.             until (abs(bdx) < 0.049) and (abs(bdy) < 0.049);
  270.         timer1.enabled := false;
  271.         formpaint(sender);
  272.         hata.repaint;
  273.         game1.enabled := true;
  274.         if cupin then begin
  275.             case shot of
  276.                 1 : aboutbox.comment.caption := 'Great Birdy !';
  277.                 2 : aboutbox.comment.caption := 'Nice Par.';
  278.                 3 : aboutbox.comment.caption := 'Boggy...';
  279.                 4 : aboutbox.comment.caption := 'Double Boggy ...';
  280.                 5 : aboutbox.comment.caption := 'Triple Boggy ...'
  281.                 else aboutbox.comment.caption :=
  282.                             'Cup in ( +' + inttostr(shot-2) + ' )';
  283.             end;
  284.             aboutbox.showmodal;
  285.             inc(score,shot);
  286.             shot := 1;
  287.             if hole = 18 then begin
  288.                 pmstr(score-36);
  289.                 with aboutbox do begin
  290.                     comment.caption := 'Finish :' + form1.label3.caption;
  291.                     showmodal;
  292.                     comment.caption := 'Save this course ?';
  293.                     cancelbtn.show;
  294.                     showmodal;
  295.                     if modalresult = mrOk then save1click(sender);
  296.                 end;
  297.                 new1click(sender);
  298.                 if modalresult <> mrOk then restart1click(sender);
  299.             end else begin
  300.                 inc(hole);
  301.                 pmstr(score - (hole - 1) * 2);
  302.                 showhole;
  303.             end;
  304.         end else begin
  305.             inc(shot);
  306.             label2.caption := 'Shot ' + inttostr(shot);
  307.         end;
  308.         label4.show;
  309.         nomove := true;
  310.     end;
  311. end;
  312.  
  313. procedure TForm1.Shape2MouseMove(Sender: TObject; Shift: TShiftState; X,
  314.   Y: Integer);
  315. begin
  316.     showxy.caption := 'Power : 0';
  317. end;
  318.  
  319. procedure TForm1.Bar1Change(Sender: TObject);
  320. begin
  321.     label5.caption := 'Friction : ' + inttostr(bar1.position);
  322.     fr := 1 - bar1.position * 0.005;
  323. end;
  324.  
  325. procedure TForm1.Bar2Change(Sender: TObject);
  326. begin
  327.     label6.caption := 'Acceleration : ' + inttostr(bar2.position);
  328.     ac := 0.0005 + bar2.position * 0.0001;
  329. end;
  330.  
  331. procedure TForm1.ResetbtnClick(Sender: TObject);
  332. begin
  333.     bar1.position := 14;
  334.     bar2.position := 14;
  335. end;
  336.  
  337. procedure TForm1.Check1Click(Sender: TObject);
  338. begin
  339.     radio1.enabled := check1.checked;
  340. end;
  341.  
  342. procedure TForm1.Timer1Timer(Sender: TObject);
  343. var xx, yy : integer;
  344. begin
  345.     bdx := bdx * fr + dx[hole,trunc(x),trunc(y)] * ac;
  346.     bdy := bdy * fr + dy[hole,trunc(x),trunc(y)] * ac;
  347.     x := x + bdx;
  348.     y := y + bdy;
  349.     if (x < 1.1) or (x >= 16.9) or (y < 1.1) or (y >= 16.9) then begin
  350.         bdx := 0;
  351.         bdy := 0;
  352.     end;
  353.     if (x < 1.1) then x := 1.1 else if (x > 16.9) then x := 16.9;
  354.     if (y < 1.1) then y := 1.1 else if (y > 16.9) then y := 16.9;
  355.     canvas.ellipse(round(x*26)-29,round(y*26)-29,round(x*26)-22,round(y*26)-22);
  356.     xx := trunc(x);
  357.     yy := trunc(y);
  358.     if map[hole,xx,yy] = 0 then begin
  359.         bdx := bdx * 0.85;
  360.         bdy := bdy * 0.85;
  361.     end;
  362.     if (xx = hx[hole]) and (yy = hy[hole]) and (bdx*bdx+bdy*bdy < 0.1) and
  363.         (trunc((x-xx)*3) = 1) and (trunc((y-yy)*3) = 1) then begin
  364.         bdx := 0.0;
  365.         bdy := 0.0;
  366.         cupin := true;
  367.     end;
  368. end;
  369.  
  370. procedure TForm1.FormCreate(Sender: TObject);
  371. begin
  372.     randomize;
  373.     nopress := true;
  374.     nomove := true;
  375.     clientheight := 26 * 16;
  376.     clientwidth := 26 * 16 + panel1.width;
  377.     path := extractfilepath(application.exename);
  378.     fname := path + 'dpgolf.dat';
  379.     readcourse;
  380.     restart1click(sender);
  381.     fr := 0.93;
  382.     ac := 0.0019;
  383. end;
  384.  
  385. procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  386.   Shift: TShiftState);
  387. begin
  388.     if (key = VK_Shift) and check1.checked and (radio1.itemindex mod 2 = 0)
  389.         then radio1.itemindex := 2 - radio1.itemindex;
  390. end;
  391.  
  392. procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  393.   Shift: TShiftState; MX, MY: Integer);
  394. begin
  395.     if check1.checked and nopress then begin
  396.         nopress := false;
  397.         mx := mx div 26 + 1;
  398.         my := my div 26 + 1;
  399.         case radio1.itemindex of
  400.           0 : case button of
  401.                 mbLeft : dx[hole,mx,my] := (dx[hole,mx,my] + 23) mod 16 - 8;
  402.                 mbRight : dx[hole,mx,my] := (dx[hole,mx,my] + 9) mod 16 - 8;
  403.               end;
  404.           1 : begin
  405.                 dx[hole,mx,my] := 0;
  406.                 dy[hole,mx,my] := 0;
  407.               end;
  408.           2 : case button of
  409.                 mbLeft : dy[hole,mx,my] := (dy[hole,mx,my] + 23) mod 16 - 8;
  410.                 mbRight : dy[hole,mx,my] := (dy[hole,mx,my] + 9) mod 16 - 8;
  411.               end;
  412.           3 : case button of
  413.                 mbLeft  : begin
  414.                             hx[hole] := mx;
  415.                             hy[hole] := my;
  416.                           end;
  417.                 mbRight : begin
  418.                             bx[hole] := mx;
  419.                             by[hole] := my;
  420.                             x := mx + 0.5;
  421.                             y := my + 0.5;
  422.                           end;
  423.               end;
  424.         end;
  425.         if (dx[hole,mx,my] = 0) and (dy[hole,mx,my] = 0)
  426.             then map[hole,mx,my] := 0 else map[hole,mx,my] := 1;
  427.         formpaint(sender);
  428.           hata.left := (hx[hole] - 1) * 26 + 8;
  429.            hata.top := (hy[hole] - 1) * 26 - 15;
  430.         hata.refresh;
  431.     end;
  432. end;
  433.  
  434. procedure TForm1.FormPaint(Sender: TObject);
  435. var i, j : byte;
  436.     k, l : integer;
  437. begin
  438.     for i := 1 to 16 do for j := 1 to 16 do begin
  439.         k := map[hole,j-1,i]     + map[hole,j,i-1] * 2 +
  440.              map[hole,j+1,i] * 4 + map[hole,j,i+1] * 8;
  441.         rect2 := rect((j-1)*26,(i-1)*26,j*26,i*26);
  442.         if map[hole,j,i] = 1 then begin
  443.             case k of
  444.                 0..4 : rect1 := rect(k*26,0,(k+1)*26,26);
  445.                 6 : rect1 := rect(130,0,156,26);
  446.                 8 : rect1 := rect(156,0,182,26);
  447.                 9 : rect1 := rect(182,0,208,26);
  448.                 12: rect1 := rect(208,0,234,26)
  449.                 else rect1 := rect(234,0,260,26);
  450.             end;
  451.             canvas.copyrect(rect2,image2.picture.bitmap.canvas,rect1);
  452.         end else begin
  453.             case k of
  454.                 3 : rect1 := rect(0,0,26,26);
  455.                 6 : rect1 := rect(26,0,52,26);
  456.                 7 : rect1 := rect(52,0,78,26);
  457.                 9 : rect1 := rect(78,0,104,26);
  458.                 11..15 : rect1 := rect((k-7)*26,0,(k-6)*26,26)
  459.                 else rect1 := rect(234,0,260,26);
  460.             end;
  461.             canvas.copyrect(rect2,image3.picture.bitmap.canvas,rect1);
  462.         end;
  463.     end;
  464.     canvas.pen.color := clwhite;
  465.     canvas.brush.color := clred;
  466.     for i := 1 to 16 do for j := 1 to 16 do if map[hole,j,i] = 1 then begin
  467.         k := i*26-13;
  468.         l := j*26-13;
  469.            canvas.polygon([point(l+dx[hole,j,i]*2,k+dy[hole,j,i]*2),
  470.              point(l-dx[hole,j,i]*2+dy[hole,j,i],k-dy[hole,j,i]*2-dx[hole,j,i]),
  471.              point(l-dx[hole,j,i]*2-dy[hole,j,i],k-dy[hole,j,i]*2+dx[hole,j,i])]);
  472.     end;
  473.     if not cupin then with canvas do begin
  474.         pen.color := clBlack;
  475.         brush.color := clWhite;
  476.         ellipse(round(x*26)-29,round(y*26)-29,round(x*26)-22,round(y*26)-22);
  477.     end;
  478. end;
  479.  
  480. end.
  481.